home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / games / stonedlx.zoo / stonedlx.gfa (.txt) < prev    next >
GFA-BASIC Atari  |  1991-08-17  |  28KB  |  1,268 lines
  1. CLEAR
  2. pl#=1
  3. npl#=1
  4. js#=1
  5. skill_level#=1
  6. IF XBIOS(4)<>0
  7.   ALERT 3,"  |  TO PLAY STONE-AGE|GO TO LOW RESOLUTION",1,"EXIT",b#
  8.   SYSTEM
  9. ENDIF
  10. DIM stone#(32,19),stickx#(10),sticky#(10),points#(2),player#(2)
  11. DIM strip$(100),file$(50),zeit#(2),punkte#(2)
  12. DIM screen$(95,31),wlvl#(2),man#(2),score#(2)
  13. DIM keydecode%(10)
  14. file$=""
  15. GOSUB screen_init
  16. FOR i#=0 TO 50
  17.   READ strip$(i#)
  18.   EXIT IF strip$(i#)="***"
  19. NEXT i#
  20. strip$(i#)=""
  21. strip$(i#+1)=""
  22. GOSUB makecolor
  23. SETCOLOR 15,7,7,7
  24. DATA Info, Instructions
  25. DATA ----------------
  26. DATA 1,2,3,4,5,6,""
  27. DATA Disk, Load World , Save World ,""
  28. DATA Play, PLAYERS  , One Player , Two Players , LEVEL TO START , Level 1 , Level 2 , Level 3 , Level 4 , Level 5 , Joy Stick , Keypad ,""
  29. DATA Genesis, New World , Create/Edit ,""
  30. DATA Leave, Bye-Bye ,""
  31. DATA ***
  32. CLS
  33. GET 75,45,235,130,help$
  34. GET 75,45,235,90,name_input$
  35. GET 0,0,309,179,clear$
  36. GET 0,0,9,9,blank$
  37. GOSUB mainscreen
  38. DO
  39.   ON MENU
  40.   '  Print At(1,1);Mousex,Mousey
  41.   '  Z$=Inkey$
  42.   '  Print At(1,3);Len(Z$),Left$(Z$)''Asc(Z$),Right$(Z$)''Asc(Right$(Z$))
  43. LOOP
  44. PROCEDURE screen_init
  45.   FOR x#=1 TO 95
  46.     screen$(x#,1)="0000000000000000000000000000000"
  47.   NEXT x#
  48.   screen$(1,1)="NO"
  49.   screen$(20,1)="NO"
  50.   screen$(39,1)="NO"
  51.   screen$(58,1)="NO"
  52.   screen$(77,1)="NO"
  53. RETURN
  54. PROCEDURE mainscreen
  55.   MENU strip$()
  56.   MENU 15,2
  57.   MENU 18,2
  58.   MENU 15+npl#,1
  59.   MENU 24+js#,1
  60.   SHOWM
  61.   DEFTEXT 12,2,0,32
  62.   TEXT 15,50,"S T O N E - A G E"
  63.   TEXT 55,80,"D E L U X E !"
  64.   DEFTEXT 3,0,0,13
  65.   TEXT 58,120,"Modified By John Hickey"
  66.   DEFTEXT 7,0,0,4
  67.   ttte$="From An ST Conversion By David Addison"
  68.   TEXT 48,170,ttte$
  69.   DEFTEXT 7,0,0,4
  70.   TEXT 70,190,"Of A Program By Klaus Kramer!"
  71.   '
  72.   ON MENU GOSUB menu
  73. RETURN
  74. PROCEDURE menu
  75.   a$=strip$(MENU(0))
  76.   IF MID$(a$,1,6)=" Level"
  77.     STICK 0
  78.     ALERT 3,"| Would You Like To| Practice Or Play?",2,"Practice|PLAY!",b#
  79.     play#=0
  80.     IF b#=2
  81.       play#=1
  82.       STICK 0
  83.       ALERT 3,"| Select Your SKILL Level",2,"Simple|Tougher|HARD!",b#
  84.       skill_level#=b#
  85.     ENDIF
  86.     FOR x#=1 TO 2
  87.       wlvl#(x#)=VAL(MID$(a$,8))
  88.     NEXT x#
  89.     HIDEM
  90.     GOSUB stoneage_play
  91.   ENDIF
  92.   IF a$=" New World "
  93.     STICK 0
  94.     ALERT 1,"| This Will OBLITERATE|      All Levels!",2,"Do It!|I Goofed!",b#
  95.     IF b#=1
  96.       GOSUB screen_init
  97.     ENDIF
  98.   ENDIF
  99.   IF a$=" Load World "
  100.     GOSUB load_world
  101.   ENDIF
  102.   IF a$=" Save World "
  103.     GOSUB save_world
  104.   ENDIF
  105.   IF a$=" Create/Edit "
  106.     GOSUB create_edit
  107.   ENDIF
  108.   IF a$=" Bye-Bye "
  109.     STICK 0
  110.     ALERT 1,"Time To Go?",2,"Yep|NO!",b#
  111.     IF b#=1
  112.       SETCOLOR 0,7,7,7
  113.       SETCOLOR 15,0,0,0
  114.       SETCOLOR 1,7,0,0
  115.       SETCOLOR 2,0,7,0
  116.       END
  117.     ENDIF
  118.   ENDIF
  119.   IF a$=" One Player "
  120.     npl#=1
  121.   ENDIF
  122.   IF a$=" Two Players "
  123.     npl#=2
  124.   ENDIF
  125.   IF a$=" Instructions"
  126.     GOSUB instructions
  127.   ENDIF
  128.   IF a$=" Joy Stick "
  129.     js#=0
  130.   ENDIF
  131.   IF a$=" Keypad "
  132.     js#=1
  133.   ENDIF
  134.   MENU OFF
  135.   MENU 16,0
  136.   MENU 17,0
  137.   MENU 24,0
  138.   MENU 25,0
  139.   MENU 15+npl#,1
  140.   MENU 24+js#,1
  141. RETURN
  142. REPEAT
  143.   a$=INKEY$
  144. UNTIL a$<>""
  145. '
  146. PROCEDURE load_world
  147.   FILESELECT "\*.SCR",file$,a$
  148.   IF a$<>""
  149.     file$=a$
  150.     DEFMOUSE 2
  151.     OPEN "I",#1,a$
  152.     FOR x#=1 TO 95
  153.       INPUT #1,a$
  154.       screen$(x#,1)=a$
  155.     NEXT x#
  156.     CLOSE
  157.   ENDIF
  158.   DEFMOUSE 0
  159. RETURN
  160. PROCEDURE save_world
  161.   FILESELECT "\*.scr",file$,a$
  162.   IF a$<>""
  163.     DEFMOUSE 2
  164.     file$=a$
  165.     OPEN "O",#2,a$
  166.     FOR x#=1 TO 95
  167.       PRINT #2,screen$(x#,1)
  168.     NEXT x#
  169.     CLOSE
  170.   ENDIF
  171.   DEFMOUSE 0
  172. RETURN
  173. PROCEDURE create_edit
  174.   GOSUB init
  175.   CLS
  176.   COLOR 2
  177.   LINE 0,180,310,180
  178.   LINE 310,0,310,180
  179.   PUT 15,183,willi$,3
  180.   PUT 48,183,rock$,3
  181.   PUT 85,183,cabbage$,3
  182.   PUT 125,183,wall$,3
  183.   PUT 159,183,world$,3
  184.   SETCOLOR 15,7,7,7
  185.   DEFTEXT 3,0,0,4
  186.   TEXT 5,198,"Willi Rock Cabbage Wall World"
  187.   DEFTEXT 7,0,0,4
  188.   TEXT 149,198,"World"
  189.   DEFTEXT 2,16,0,6
  190.   TEXT 185,190,"1 2 3 4 5"
  191.   DEFTEXT 6,0,0,4
  192.   TEXT 195,198,"Level Names"
  193.   DEFTEXT 3,0,4
  194.   TEXT 285,188,"MAIN"
  195.   TEXT 285,198,"MENU"
  196.   wlvl#(pl#)=1
  197.   GOSUB world_select
  198.   DO
  199.     WHILE MOUSEK=0
  200.       z$=INKEY$
  201.       IF MID$(z$,2,1)="b"
  202.         GOSUB help_edit
  203.       ENDIF
  204.       '      Print At(1,1);Mousex,Mousey
  205.     WEND
  206.     mx#=MOUSEX
  207.     my#=MOUSEY
  208.     mk#=MOUSEK
  209.     EXIT IF (mx#>283 AND mx#<310) AND my#>180
  210.     IF my#>180
  211.       IF mx#>183 AND mx#<273 AND my#<=190
  212.         IF mk#=1
  213.           wlvl#(pl#)=ABS(-1+(mx#>202)+(mx#>223)+(mx#>243)+(mx#>263))
  214.           GOSUB world_select
  215.         ELSE
  216.           GOSUB copy_erase
  217.         ENDIF
  218.       ENDIF
  219.       IF mx#>183 AND mx#<273 AND my#>190
  220.         GOSUB change_name
  221.       ENDIF
  222.       IF mx#>12 AND mx#<169
  223.         DEFTEXT 3,0,0,4
  224.         TEXT 5,198,"Willi Rock Cabbage Wall World"
  225.         DEFTEXT 7,0,0,4
  226.         IF mx#<26
  227.           drm$=willi$
  228.           drm#=2
  229.           TEXT 5,198,"Willi"
  230.         ENDIF
  231.         IF mx#>45 AND mx#<58
  232.           drm$=rock$
  233.           drm#=1
  234.           TEXT 41,198,"Rock"
  235.         ENDIF
  236.         IF mx#>83 AND mx#<95
  237.           drm$=cabbage$
  238.           drm#=3
  239.           TEXT 71,198,"Cabbage"
  240.         ENDIF
  241.         IF mx#>123 AND mx#<135
  242.           drm$=wall$
  243.           drm#=4
  244.           TEXT 119,198,"Wall"
  245.         ENDIF
  246.         IF mx#>157 AND mx#<169
  247.           drm$=world$
  248.           drm#=0
  249.           TEXT 149,198,"World"
  250.         ENDIF
  251.       ENDIF
  252.     ENDIF
  253.     IF my#<180 AND mx#<310
  254.       IF mk#=2
  255.         drt$=drm$
  256.         drt#=drm#
  257.         drm$=blank$
  258.         drm#=5
  259.       ENDIF
  260.       PUT INT(mx#/10)*10,INT(my#/10)*10,drm$
  261.       a$=screen$((wlvl#(pl#)-1)*19+2+INT(my#/10),1)
  262.       MID$(a$,INT(mx#/10)+1,1)=STR$(drm#)
  263.       screen$((wlvl#(pl#)-1)*19+2+INT(my#/10),1)=a$
  264.       IF mk#=2
  265.         drm$=drt$
  266.         drm#=drt#
  267.       ENDIF
  268.     ENDIF
  269.   LOOP
  270.   CLS
  271.   GOSUB mainscreen
  272. RETURN
  273. '
  274. PROCEDURE copy_erase
  275.   STICK 0
  276.   ALERT 2,"|    Copy/Erase Level     | |     Which One?",3,"Copy|Erase|Neither",b#
  277.   IF b#=1
  278.     GOSUB copy
  279.   ENDIF
  280.   IF b#=2
  281.     GOSUB erase
  282.   ENDIF
  283. RETURN
  284. '
  285. PROCEDURE copy
  286.   GET 75,45,235,90,temp$
  287.   PUT 75,45,name_input$
  288.   BOX 77,47,233,88
  289.   PRINT AT(12,8);"CLICK On Level"
  290.   PRINT AT(12,9);"To Copy FROM"
  291.   DO
  292.     REPEAT
  293.     UNTIL MOUSEK
  294.     mx#=MOUSEX
  295.     my#=MOUSEY
  296.     mk#=MOUSEK
  297.     EXIT IF mx#>183 AND mx#<273 AND my#<=190
  298.   LOOP
  299.   cfrom#=ABS(-1+(mx#>202)+(mx#>223)+(mx#>243)+(mx#>263))
  300.   PUT 75,45,name_input$
  301.   BOX 77,47,233,88
  302.   PRINT AT(12,8);"CLICK On Level"
  303.   PRINT AT(12,9);"  To Copy TO"
  304.   PAUSE 10
  305.   DO
  306.     REPEAT
  307.     UNTIL MOUSEK
  308.     mx#=MOUSEX
  309.     my#=MOUSEY
  310.     mk#=MOUSEK
  311.     EXIT IF mx#>183 AND mx#<273 AND my#<=190
  312.   LOOP
  313.   cto#=ABS(-1+(mx#>202)+(mx#>223)+(mx#>243)+(mx#>263))
  314.   PUT 75,45,temp$
  315.   mx#=0
  316.   my#=0
  317.   mk#=0
  318.   PAUSE 10
  319.   FOR i#=1 TO 19
  320.     screen$(i#+(cto#-1)*19,1)=screen$(i#+(cfrom#-1)*19,1)
  321.   NEXT i#
  322.   wlvl#(pl#)=cto#
  323.   GOSUB world_select
  324. RETURN
  325. '
  326. PROCEDURE erase
  327.   GET 75,45,235,90,temp$
  328.   PUT 75,45,name_input$
  329.   BOX 77,47,233,88
  330.   PRINT AT(12,8);"CLICK On Level"
  331.   PRINT AT(12,9);"  To ERASE"
  332.   DO
  333.     REPEAT
  334.     UNTIL MOUSEK
  335.     mx#=MOUSEX
  336.     my#=MOUSEY
  337.     mk#=MOUSEK
  338.     EXIT IF mx#>183 AND mx#<273 AND my#<=190
  339.   LOOP
  340.   elvl#=ABS(-1+(mx#>202)+(mx#>223)+(mx#>243)+(mx#>263))
  341.   PUT 75,45,name_input$
  342.   PAUSE 10
  343.   PUT 75,45,temp$
  344.   b$="|  Erase Level "+STR$(elvl#)+"?  "
  345.   STICK 0
  346.   ALERT 2,b$,2,"You Bet|Oops,No!",b#
  347.   IF b#=1
  348.     FOR i#=1 TO 19
  349.       screen$(i#+(elvl#-1)*19,1)="0000000000000000000000000000000"
  350.     NEXT i#
  351.     screen$(1+(elvl#-1)*19,1)="NO"
  352.     wlvl#(pl#)=elvl#
  353.     GOSUB world_select
  354.   ENDIF
  355. RETURN
  356. '
  357. PROCEDURE world_select
  358.   HIDEM
  359.   PUT 0,0,clear$
  360.   DEFFILL 0,2,8
  361.   a$="188207230249270"
  362.   FOR y#=1 TO 5
  363.     FILL VAL(MID$(a$,((y#-1)*3+1),3)),189
  364.   NEXT y#
  365.   DEFFILL 7,2,8
  366.   FILL VAL(MID$(a$,((wlvl#(pl#)-1)*3+1),3)),189
  367.   GOSUB show_screen
  368.   IF na$="NO"
  369.     GOSUB change_name
  370.   ENDIF
  371.   DEFTEXT 6,0,0,4
  372.   TEXT 183,198,"                "
  373.   TEXT 183,198,na$
  374.   screen$(1+(wlvl#(pl#)-1)*19,1)=na$
  375.   SHOWM
  376. RETURN
  377. '
  378. PROCEDURE change_name
  379.   GET 75,45,235,90,temp$
  380.   PUT 75,45,name_input$
  381.   BOX 77,47,233,87
  382.